unit oPathFinding;

interface

uses uOSPList, oCell, oCellularWorld, SysUtils, StdCtrls, oEntity;

type

//prioritny zoznam pre ucely funkcie getWay(vklada sa tCalcCell)
tPriorList = class(tOspList)
  private
  public
    function OrderIn(M, N : tNode) : boolean; override;
    function Find(var Key) : tNode; override;
    constructor Create;
end;


// toto vsetko pouzivam iba v metode getWay a tak to nemusi byt cely cas na kazdej bunke
tCalcCell = class(tNode)
  private
    //last cell in a road
    aPrev: TCalcCell;
    aF: real; // sth from cell simulation  // total cost, F = G + H
    aG: real; // sth from cell simulation  // cost for moving there
    aH: real; // sth from cell simulation  // manhattan distance
    aX : integer;//position in tCellularWorld - Miso 25.5
    aY : integer;//position in tCellularWorld - Miso 25.5
  public
    property F : real read aF write aF;
    property G : real read aG write aG;
    property H : real read aH write aH;
    property X : integer read aX write aX;
    property Y : integer read aY write aY;
    property Prev : TCalcCell read aPrev write aPrev;
    constructor Create(paCell : tCell); overload;
    constructor Create(paX, paY : integer); overload;
end;


function GetWay(paLevel : tCellularWorld; paStart, paGoal : tCell) : tOspList;
function GetG(paAct, paPrev : tCalcCell) : real;
function GetManhatanDistance(paLevel : tCellularWorld; paStart : tCalcCell; paGoal : tCell) : real; overload;
function GetManhatanDistance(paLevel : tCellularWorld; paStart , paGoal : tCell) : real; overload;
function GetNeighbourCells(paLevel : tCellularWorld; paCell : tCalcCell) : tOspList; overload;
function GetNeighbourCells(paLevel : fMatrix; paCell : tCalcCell) : tOspList; overload;
function IsIndexOK(paLevel : TCellularWorld; paX,paY:integer) : boolean; overload;//ci sa mozem pytat na dane suradnice v cellsvete paLevel
function IsIndexOK(paLevel : fMatrix; paX,paY:integer) : boolean;overload;
function GetBarrierMatrix(paWorld : tCellularWorld) : fMatrix;
procedure ReleaseMatrix(paMatrix : fMatrix);

procedure VypisZoznamy(paOpen, paClosed : tPriorList; paNeighbours : tOspList; paMemo : tMemo);



var Hodnota : integer;



implementation

function GetNeighbourCells(paLevel : fMatrix; paCell : tCalcCell) : tOspList;
  var i, j : integer;
      list : tOspList;
      pom : tCalcCell;
begin
  list := tOspList.Create;
  for i := -1 to 1 do
    for j := -1 to 1 do begin
      if IsIndexOK(paLevel, paCell.X + i, paCell.Y + j) then // ak sa nepytam mimo
      if Not ((i = 0) and (j = 0)) then //ak to nie je bunka na susedov ktorej sa pytam
      if paLevel[paCell.X + i, paCell.Y + j] = 0 then  // ak to nie je bariera
      if ((paLevel[paCell.X + i, paCell.Y] = 0) OR
          (paLevel[paCell.X, paCell.Y + j] = 0)) then begin // obchadzanie rohov
        pom := tCalcCell.Create(paCell.X + i, paCell.Y + j);
        list.FirstIn(pom);
      end;
    end;
  result := list;

end;

procedure ReleaseMatrix(paMatrix : fMatrix);
  var i, j : integer;
begin
  for I := 0 to length(paMAtrix) - 1 do
    for j := 0 to length(paMatrix[i]) - 1 do
      setlength(paMatrix[i], 0);
  setlength(paMatrix , 0);
  paMatrix := nil;
end;


function GetBarrierMatrix(paWorld : tCellularWorld) : fMatrix;
  var pom : fMatrix;
      i, j : integer;
begin
  setlength(pom, paWorld.Columns);
  for I := 0 to paWorld.Columns - 1 do
    setlength(pom[i], paWorld.Rows);
  for I := 0 to paWorld.Columns - 1 do
    for j := 0 to paWorld.Rows - 1 do
      if paWorld.Cell[i ,j].IsBarrier then pom[i, j] := 1
      else pom[i ,j] := 0;
  result := pom;
end;


procedure VypisZoznamy(paOpen, paClosed : tPriorList; paNeighbours : tOspList; paMemo : tMemo);
  var s : string;
      i : integer;
      pom : tCalcCell;
begin
  paMemo.Clear;
  s := '';
  pom := tCalcCell(paOpen.GetFirst);
  i := 1;
  while pom <> nil do begin
    s := s + inttostr(i) + ': X=' + inttostr(pom.aX) + ', Y=' + inttostr(pom.aY) +  '| F=' + floattostr(pom.F) + '| G=' + floattostr(pom.G) + '| H=' + floattostr(pom.H) + '||||';
    pom := tCalcCell(pom.GetSucc);
    inc(i);
  end;
  paMemo.Lines.Add('OPEN :');
  paMemo.Lines.Add(S);

  s := '';
  pom := tCalcCell(paClosed.GetFirst);
  i := 1;
  while pom <> nil do begin
    s := s + inttostr(i) + ': X=' + inttostr(pom.aX) + ', Y=' + inttostr(pom.aY) +  '| F=' + floattostr(pom.F) + '| G=' + floattostr(pom.G) + '| H=' + floattostr(pom.H) + '||||';
    pom := tCalcCell(pom.GetSucc);
    inc(i);
  end;
  paMemo.Lines.Add('CLOSED :');
  paMemo.Lines.Add(S);

  s := '';
  if paNeighbours <> nil then begin
    pom := tCalcCell(paNeighbours.GetFirst);
    i := 1;
    while pom <> nil do begin
      s := s + inttostr(i) + ': X=' + inttostr(pom.aX) + ', Y=' + inttostr(pom.aY) +  '| F=' + floattostr(pom.F) + '| G=' + floattostr(pom.G) + '| H=' + floattostr(pom.H) + '||||';
      pom := tCalcCell(pom.GetSucc);
      inc(i);
    end;
  end;
  paMemo.Lines.Add('NEIGHBOURS :');
  paMemo.Lines.Add(S);
end;



function IsIndexOK(paLevel : TCellularWorld; paX,paY:integer):boolean;
begin
  if (paX > -1) and (paY > -1) and (paX < paLevel.Columns) and (paY < paLevel.Rows)   then
    result := true
  else
    result := false;
end;

function IsIndexOK(paLevel : fMatrix; paX,paY:integer):boolean;
begin
  if (paX > -1) and (paY > -1) and (paX < length(paLevel)) and (paY < length(paLevel[0]))   then
    result := true
  else
    result := false;
end;



constructor tCalcCell.Create(paCell: TCell);
begin
  inherited Create;
  aPrev := nil;
  aX := paCell.X;
  aY := paCell.Y;
  aF := 0;
  aG := 0;
  aH := 0;
end;

constructor tCalcCell.Create(paX, paY : integer);
begin
  inherited Create;
  aPrev := nil;
  aX := paX;
  aY := paY;
  aF := 0;
  aG := 0;
  aH := 0;
end;


function tPriorList.Find(var Key) : tNode;
  var pom : tCalcCell;
begin
  result := nil;
  pom := tCalcCell(self.GetFirst);
  while (pom <> nil) do begin
    if (tCalcCell(Key).x = pom.x) and (tCalcCell(Key).Y = pom.y) then begin
      result := pom;
      pom := nil;
    end
    else
      pom := tCalcCell(pom.GetSucc);
  end;
end;


function GetWay(paLevel : tCellularWorld; paStart, paGoal : tCell) : tOspList;
  var Open, Closed : tPriorList;
      Neighbours, Way : tOspList;
      act, pom, pom2, pom3 : tCalcCell;
      world : fMatrix;
      //astar : fMatrix;
begin

  world := GetBarrierMatrix(paLEvel);
  {astar := GetBarrierMatrix(paLEvel);
  astar[paStart.X, paStart.Y] := 2;
  astar[paGoal.X, paGoal.Y] := 3;

  Matica := astar;
  VykresliMaticu.Show;}

  Open := tPriorList.Create;
  Closed := tPriorList.Create;
  act := tCalcCell.Create(paStart);
  act.H := GetManhatanDistance(paLevel, paStart, paGoal);
  act.F := act.H;
  Open.Insert(act);
  neighbours := nil;
  {astar[act.aX, act.aY] := 4;
  VykresliMaticu.Grid.Repaint; /////////
  VypisZoznamy(open, closed, neighbours, VykresliMaticu.memo); }
  while (act <> nil) and ((act.x <> paGoal.x) or (act.y <> paGoal.Y)) do begin
    act := tCalcCell(open.FirstOut);
    //astar[act.aX, act.aY] := 4;
    if act <> nil then begin
      closed.LastIn(act);
      //astar[act.aX, act.aY] := 5;
      neighbours := GetNeighbourCells(world, act);
      pom := tCalcCell(neighbours.FirstOut);
      {VykresliMaticu.Grid.Repaint; /////////////
      VypisZoznamy(open, closed, neighbours, VykresliMaticu.memo);  }
      while pom <> nil do begin
        pom3 := tCalcCell(closed.Find(pom));
        if pom3 = nil then begin
          pom2 := tCalcCell(open.Find(pom));
          if pom2 = nil then begin
            pom.h := getManhatanDistance(paLevel, pom, paGoal);
            pom.g := getG(pom, act) + act.g;
            Pom.f := pom.h + pom.g;
            pom.Prev := act;
            open.Insert(pom);
            {VykresliMaticu.Grid.Repaint;
            VypisZoznamy(open, closed, neighbours, VykresliMaticu.memo);
            astar[pom.aX, pom.aY] := 4;    }
          end
          else begin
            pom.h := getManhatanDistance(paLevel, pom2, paGoal);
            pom.g := getG(pom, act) + act.g;
            pom.f := pom.h + pom.g;
            pom.Prev := act;
            //VypisZoznamy(open, closed, neighbours, VykresliMaticu.memo);
            if pom2.f > pom.f then begin
              pom2.OutOfList;
              open.Insert(pom);
              {astar[pom.aX, pom.aY] := 4;
              VykresliMaticu.Grid.Repaint;
              VypisZoznamy(open, closed, neighbours, VykresliMaticu.memo);  }
              FreeAndNil(pom2);
              //VykresliMaticu.Grid.Repaint;/////////
            end
            else FreeAndNil(pom);
          end;
          pom := tCalcCell(Neighbours.FirstOut);
        end
        else begin
          FreeAndNil(pom);
          pom := tCalcCell(Neighbours.FirstOut);
         // VykresliMaticu.Grid.Repaint;/////////
        end;
      end;
      FreeAndNil(Neighbours);
    end;
  end;
  //zrekonstrouvanie cesty
  FreeandNil(Open);
  pom := tCalcCell(closed.GetLast);
  way := tOspList.Create;
  while pom.Prev <> nil do begin
    if  paLevel.Cell[pom.X,pom.y].Way = 0 then  paLevel.Cell[pom.X,pom.y].Way := Hodnota
    else  paLevel.Cell[pom.X,pom.y].Way := 3;
    way.FirstIn(paLevel.Cell[pom.X,pom.y]);
    pom3 := pom.Prev;
    FreeAndNil(pom);
    pom := pom3;
    pom3 := nil;
  end;
  FreeAndNil(Closed);
  FreeAndNil(NeighBours);
  ReleaseMatrix(world);
  //ReleaseMatrix(astar);
  result := Way;
end;

function GetG(paAct, paPrev : tCalcCell) : real;
  var pom : real;
begin
  //bud pripocita 10(dlzka hrany), alebo 14(priblizna dlzka uhlopriecky)
  if (paAct.X = paPrev.X) or (paAct.Y = paPrev.Y) then pom := 10
    else pom := 14;
  result := paAct.G + pom;
end;


function GetManhatanDistance(paLevel : tCellularWorld; paStart , paGoal : tCell) : real;
begin
  result := 10 * abs(paStart.X - paGoal.X)  +  10 * abs(paStart.Y - paGoal.Y);
  //result := paLevel.CellHeight * (abs(paStart.X - paGoal.X)  +  abs(paStart.Y - paGoal.Y));
end;

function GetManhatanDistance(paLevel : tCellularWorld; paStart : tCalcCell; paGoal : tCell) : real;
begin
  result := 10 * abs(paStart.X - paGoal.X)  +  10 * abs(paStart.Y - paGoal.Y);
  //result := paLevel.CellHeight * (abs(paStart.X - paGoal.X)  +  abs(paStart.Y - paGoal.Y));
end;


function tPriorList.OrderIn(M, N : tNode) : boolean;
begin
  if tCalcCell(M).f < tCalcCell(N).f then
    result := true
  else
    result := false;
end;

constructor tPriorList.Create;
begin
  inherited Create;
end;


function GetNeighbourCells(paLevel : tCellularWorld; paCell : tCalcCell) : tOspList;
  var i, j : integer;
      list : tOspList;
      pom : tCalcCell;
begin
  list := tOspList.Create;
  for i := -1 to 1 do
    for j := -1 to 1 do begin
      if IsIndexOK(paLevel, paCell.X + i, paCell.Y + j) then // ak sa nepytam mimo
      if Not ((i = 0) and (j = 0)) then //ak to nie je bunka na susedov ktorej sa pytam
      if Not paLevel.Cell[paCell.X + i, paCell.Y + j].IsBarrier then  // ak to nie je bariera
      if (Not (paLevel.Cell[paCell.X + i, paCell.Y]).IsBarrier) AND
         (Not (paLevel.Cell[paCell.X, paCell.Y + j]).IsBarrier) then begin // obchadzanie rohov
        pom := tCalcCell.Create(paLevel.Cell[paCell.X + i, paCell.Y + j]);
        list.FirstIn(pom);
      end;
    end;
  result := list;
end;

end.
